home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt40s3.arc / PIBHOSTB.MOD < prev    next >
Text File  |  1987-09-08  |  32KB  |  797 lines
  1. (*----------------------------------------------------------------------*)
  2. (*  Process_File_Transfer_Commands --- Process file transfer commands   *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Process_File_Transfer_Commands( VAR Done: BOOLEAN;
  6.                                           VAR Back: BOOLEAN );
  7.  
  8. (*----------------------------------------------------------------------*)
  9. (*                                                                      *)
  10. (*     Procedure:  Process_File_Transfer_Commands                       *)
  11. (*                                                                      *)
  12. (*     Purpose:    Controls processing of file transfer commands.       *)
  13. (*                                                                      *)
  14. (*     Calling Sequence:                                                *)
  15. (*                                                                      *)
  16. (*        Process_File_Transfer_Commands( VAR Done: BOOLEAN;            *)
  17. (*                                        VAR Back: BOOLEAN );          *)
  18. (*                                                                      *)
  19. (*           Done --- set TRUE if quit command entered or carrier       *)
  20. (*                    dropped.                                          *)
  21. (*           Back --- set TRUE if return to main menu requested.        *)
  22. (*                                                                      *)
  23. (*----------------------------------------------------------------------*)
  24.  
  25. VAR
  26.    Ch       : CHAR;
  27.    Found_Ch : BOOLEAN;
  28.    Dont_Echo: BOOLEAN;
  29.  
  30. LABEL
  31.    ReadChar;
  32.  
  33. (*----------------------------------------------------------------------*)
  34. (*      Display_Xfer_Commands --- Display file transfer commands        *)
  35. (*----------------------------------------------------------------------*)
  36.  
  37. PROCEDURE Display_Xfer_Commands;
  38.  
  39. (*----------------------------------------------------------------------*)
  40. (*                                                                      *)
  41. (*     Procedure: Display_Xfer_Commands                                 *)
  42. (*                                                                      *)
  43. (*     Purpose:   Displays menu of PibTerm file transfer commands and   *)
  44. (*                prompts for command entry.                            *)
  45. (*                                                                      *)
  46. (*     Calling sequence:                                                *)
  47. (*                                                                      *)
  48. (*        Display_Xfer_Commands;                                        *)
  49. (*                                                                      *)
  50. (*----------------------------------------------------------------------*)
  51.  
  52. BEGIN (* Display_Xfer_Commands *)
  53.  
  54.    IF ( NOT Expert_On ) THEN
  55.       BEGIN
  56.          Host_Send_String_With_CR(' ');
  57.          Host_Send_String_With_CR('======================================================');
  58.          Host_Send_String_With_CR('=        PibTerm Host Mode File Transfer Menu        =');
  59.          Host_Send_String_With_CR('======================================================');
  60.          Host_Send_String_With_CR(' ');
  61.          Host_Send_String_With_CR('     U=Upload file');
  62.          Host_Send_String_With_CR('     D=Download file');
  63.          Host_Send_String_With_CR('     L=List files for transfer');
  64.          IF ( Privilege = 'S' ) THEN
  65.             Host_Send_String_With_CR('     J=Jump to DOS');
  66.          Host_Send_String_With_CR('     M=Return to main menu');
  67.          Host_Send_String_With_CR('     Q=Quit and logoff');
  68.          Host_Send_String_With_CR('     X=Expert mode');
  69.          Host_Send_String_With_CR(' ');
  70.          Host_Send_String_With_CR('======================================================');
  71.          Host_Send_String_With_CR(' ');
  72.          Host_Send_String_And_Echo('Enter command ? ');
  73.       END
  74.    ELSE
  75.       BEGIN
  76.          Host_Send_String_With_CR(' ');
  77.          IF ( Privilege = 'S' ) THEN
  78.             Host_Send_String_And_Echo('Xfer (U,D,J,L,M,Q,X) ? ')
  79.          ELSE
  80.             Host_Send_String_And_Echo('Xfer (U,D,L,M,Q,X) ? ');
  81.       END;
  82.  
  83.    IF ( NOT Local_Host ) THEN
  84.       Async_Purge_Buffer;
  85.  
  86. END   (* Display_Xfer_Commands *);
  87.  
  88. (*----------------------------------------------------------------------*)
  89. (*    List_Files_For_Transfer --- List files available for transfer     *)
  90. (*----------------------------------------------------------------------*)
  91.  
  92. PROCEDURE List_Files_For_Transfer;
  93.  
  94. (*----------------------------------------------------------------------*)
  95. (*                                                                      *)
  96. (*     Procedure: List_Files_For_Transfer                               *)
  97. (*                                                                      *)
  98. (*     Purpose:   Displays files available for transfer.                *)
  99. (*                                                                      *)
  100. (*     Calling sequence:                                                *)
  101. (*                                                                      *)
  102. (*        List_Files_For_Transfer;                                      *)
  103. (*                                                                      *)
  104. (*                                                                      *)
  105. (*     Remarks:                                                         *)
  106. (*                                                                      *)
  107. (*        This procedure sends the contents of the PIBTERM.XFR file to  *)
  108. (*        the remote user.                                              *)
  109. (*                                                                      *)
  110. (*----------------------------------------------------------------------*)
  111.  
  112. VAR
  113.    LCount            : INTEGER;
  114.    LDone             : BOOLEAN;
  115.    XFer_Line         : AnyStr;
  116.    Xfer_List_File    : Text_File   (* File transfer list file    *);
  117.  
  118. BEGIN (* List_Files_For_Transfer *)
  119.  
  120.                                    (* Open xferlist file *)
  121.    Host_Status('List files');
  122.  
  123.    ASSIGN( Xfer_List_File , Home_Dir + 'PIBTERM.XFR' );
  124.       (*$I-*)
  125.    RESET( Xfer_List_File );
  126.       (*$I+*)
  127.                                    (* If not there, no transfer possible *)
  128.    IF Int24Result <> 0 THEN
  129.       BEGIN
  130.          Host_Send_String( CR_LF_Host );
  131.          Host_Send_String_With_CR('No files available for transfer.');
  132.       END
  133.    ELSE                            (* If there, list it *)
  134.       BEGIN
  135.  
  136.          LCount := 2;
  137.          LDone  := FALSE;
  138.  
  139.          Host_Send_String( CR_LF_Host );
  140.          Host_Send_String_With_CR('List of files available for transfer: ');
  141.          Host_Send_String_With_CR(' ');
  142.  
  143.          List_Prompt( LCount , LDone );
  144.  
  145.          REPEAT
  146.  
  147.             READLN( Xfer_List_File , Xfer_Line );
  148.  
  149.             Host_Send_String_With_CR( Xfer_Line );
  150.  
  151.             List_Prompt( LCount , LDone );
  152.  
  153.          UNTIL ( EOF( Xfer_List_File ) OR LDone );
  154.  
  155.       END;
  156.  
  157.       (*$I-*)
  158.    CLOSE( Xfer_List_File );
  159.       (*$I+*)
  160.  
  161.    Host_Send_String_With_CR(' ');
  162.    Host_Prompt_And_Read_String('Finished listing files, hit <CR> to continue: ',
  163.                                Xfer_Line, TRUE );
  164.    Host_Send_String_With_CR(' ');
  165.  
  166.    Write_Log('List files for transfer.', FALSE, FALSE );
  167.  
  168.    Host_Status( Cur_Host_Status );
  169.  
  170. END   (* List_Files_For_Transfer *);
  171.  
  172. (*----------------------------------------------------------------------*)
  173. (*        Display_Xfer_Protocols --- Display file xfer protocols        *)
  174. (*----------------------------------------------------------------------*)
  175.  
  176. PROCEDURE Display_Xfer_Protocols;
  177.  
  178. (*----------------------------------------------------------------------*)
  179. (*                                                                      *)
  180. (*     Procedure: Display_Xfer_Protocols;                               *)
  181. (*                                                                      *)
  182. (*     Purpose:   Displays available file transfer protocols.           *)
  183. (*                                                                      *)
  184. (*     Calling sequence:                                                *)
  185. (*                                                                      *)
  186. (*        Display_Xfer_Protocols;                                       *)
  187. (*                                                                      *)
  188. (*----------------------------------------------------------------------*)
  189.  
  190. VAR
  191.    T : Transfer_Type;
  192.    I : INTEGER;
  193.    S : AnyStr;
  194.  
  195. BEGIN (* Display_Xfer_Protocols *)
  196.  
  197.    Host_Send_String( CR_LF_Host );
  198.    Host_Send_String_With_CR('Available transfer protocols are: ');
  199.    Host_Send_String_With_CR(' ');
  200. {
  201.    Host_Send_String_With_CR('   A         Ascii');
  202.    Host_Send_String_With_CR('   X         Xmodem CheckSum');
  203.    Host_Send_String_With_CR('   XC        Xmodem CRC');
  204.    Host_Send_String_With_CR('   XK        Xmodem 1K');
  205.    Host_Send_String_With_CR('   XG        Xmodem 1K G');
  206.    Host_Send_String_With_CR('   YB        Ymodem Batch');
  207.    Host_Send_String_With_CR('   YG        Ymodem G Batch');
  208.    Host_Send_String_With_CR('   T         Telink');
  209.    Host_Send_String_With_CR('   M         Modem7 Batch Checksum');
  210.    Host_Send_String_With_CR('   MC        Modem7 Batch CRC');
  211.    Host_Send_String_With_CR('   K         Kermit (Text file)');
  212.    Host_Send_String_With_CR('   KB        Kermit (Binary file)');
  213.    Host_Send_String_With_CR('   SL        SEALink');
  214.    Host_Send_String_With_CR('   RL        RLink');
  215.    Host_Send_String_With_CR('   WX        Windowed Xmodem');
  216. }
  217.    FOR I := 1 TO Max_Transfer_Types DO
  218.       BEGIN
  219.          T := Transfers[I];
  220.          IF ( ( Trans_Type_Name[T]  <> '  ' ) AND
  221.               ( Trans_OK_In_Host[T] OR ( Privilege = 'S' ) ) ) THEN
  222.             BEGIN
  223.                S := '   ' + COPY( Trans_Type_Name[T], 1, 2 ) + '        ' +
  224.                     Transfer_Name_List[I];
  225.                Host_Send_String_With_CR( S );
  226.             END;
  227.       END;
  228.  
  229.    Host_Send_String_With_CR('   Q or ^X  Quit transfer');
  230.  
  231. END   (* Display_Xfer_Protocols *);
  232.  
  233. (*----------------------------------------------------------------------*)
  234. (*              Get_Xfer_Protocol --- Get file xfer protocol            *)
  235. (*----------------------------------------------------------------------*)
  236.  
  237. FUNCTION Get_Xfer_Protocol : Transfer_Type;
  238.  
  239. (*----------------------------------------------------------------------*)
  240. (*                                                                      *)
  241. (*     Function:  Get_Xfer_Protocol;                                    *)
  242. (*                                                                      *)
  243. (*     Purpose:   Prompts remote user for, and reads, selected file     *)
  244. (*                transfer protocol.                                    *)
  245. (*                                                                      *)
  246. (*     Calling sequence:                                                *)
  247. (*                                                                      *)
  248. (*        Trans_Type := Get_Xfer_Protocol : Transfer_Type;              *)
  249. (*                                                                      *)
  250. (*           Trans_Type --- Protocol chosen by remote user.             *)
  251. (*                                                                      *)
  252. (*----------------------------------------------------------------------*)
  253.  
  254. VAR
  255.    Trans_Mode        : ShortStr;
  256.    Transfer_Protocol : Transfer_Type;
  257.    I                 : INTEGER;
  258.    Trans_Mode_Char2  : Char_2;
  259.    T                 : Transfer_Type;
  260.  
  261. BEGIN (* Get_Xfer_Protocol *)
  262.  
  263.    REPEAT
  264.  
  265.       Host_Send_String( CR_LF_Host );
  266.       Host_Prompt_And_Read_String('Enter transfer protocol (? for list, ^X to quit): ',
  267.                                    Trans_Mode, TRUE );
  268.  
  269.       Trans_Mode_Char2[1] := ' ';
  270.       Trans_Mode_Char2[2] := ' ';
  271.  
  272.       Trans_Mode := Uppercase( TRIM( Trans_Mode ) );
  273.  
  274.       FOR I := 1 TO MIN( LENGTH( Trans_Mode ) , 2 ) DO
  275.          Trans_Mode_Char2[I] := Trans_Mode[I];
  276.  
  277.       Transfer_Protocol := None;
  278.  
  279.       IF ( Trans_Mode = '?' ) THEN
  280.          Display_Xfer_Protocols
  281.       ELSE IF ( ( Trans_Mode <> ^X ) AND ( Trans_Mode <> 'Q' ) ) THEN
  282.          FOR I := 1 TO Max_Transfer_Types DO
  283.             BEGIN
  284.                T := Transfers[I];
  285.                IF ( ( Trans_Mode_Char2 = Trans_Type_Name[T] ) AND
  286.                     ( Trans_OK_In_Host[T] OR ( Privilege = 'S' ) ) ) THEN
  287.                   Transfer_Protocol := T;
  288.             END;
  289. {
  290.       ELSE IF Trans_Mode = 'A'  THEN
  291.          Transfer_Protocol := Ascii
  292.       ELSE IF Trans_Mode = 'X'  THEN
  293.          Transfer_Protocol := Xmodem_Chk
  294.       ELSE IF Trans_Mode = 'XC' THEN
  295.          Transfer_Protocol := Xmodem_CRC
  296.       ELSE IF Trans_Mode = 'XG'  THEN
  297.          Transfer_Protocol := Xmodem_1KG
  298.       ELSE IF Trans_Mode = 'XK'  THEN
  299.          Transfer_Protocol := Xmodem_1K
  300.       ELSE IF Trans_Mode = 'YB' THEN
  301.          Transfer_Protocol := Ymodem_Batch
  302.       ELSE IF Trans_Mode = 'YG' THEN
  303.          Transfer_Protocol := Ymodem_G
  304.       ELSE IF Trans_Mode = 'T'  THEN
  305.          Transfer_Protocol := Telink
  306.       ELSE IF Trans_Mode = 'TC' THEN
  307.          Transfer_Protocol := Telink
  308.       ELSE IF Trans_Mode = 'M'  THEN
  309.          Transfer_Protocol := Modem7_Chk
  310.       ELSE IF Trans_Mode = 'MC'  THEN
  311.          Transfer_Protocol := Modem7_CRC
  312.       ELSE IF Trans_Mode = 'M7' THEN
  313.          Transfer_Protocol := Modem7_CRC
  314.       ELSE IF Trans_Mode = 'K' THEN
  315.          BEGIN
  316.             Transfer_Protocol    := Kermit;
  317.             Kermit_File_Type_Var := Kermit_Ascii;
  318.          END
  319.       ELSE IF Trans_Mode = 'KB' THEN
  320.          BEGIN
  321.             Transfer_Protocol    := Kermit;
  322.             Kermit_File_Type_Var := Kermit_Binary;
  323.          END
  324.       ELSE IF Trans_Mode = 'RL'  THEN
  325.          Transfer_Protocol := RLink
  326.       ELSE IF Trans_Mode = 'SL'  THEN
  327.          Transfer_Protocol := SEALink
  328.       ELSE IF Trans_Mode = 'WX' THEN
  329.          Transfer_Protocol := WXModem;
  330. }
  331.    UNTIL ( Transfer_Protocol <> None ) OR ( Trans_Mode = 'Q' ) OR
  332.          ( Trans_Mode = ^X );
  333.  
  334.    Get_Xfer_Protocol := Transfer_Protocol;
  335.  
  336.    IF ( Transfer_Protocol = Kermit ) THEN
  337.       Kermit_File_Type_Var := Kermit_Binary;
  338.  
  339. END   (* Get_Xfer_Protocol *);
  340.  
  341. (*----------------------------------------------------------------------*)
  342. (*               Upload_A_File  --- Receive file from remote user       *)
  343. (*----------------------------------------------------------------------*)
  344.  
  345. PROCEDURE Upload_A_File;
  346.  
  347. (*----------------------------------------------------------------------*)
  348. (*                                                                      *)
  349. (*     Procedure:  Upload_A_File;                                       *)
  350. (*                                                                      *)
  351. (*     Purpose:   Prompts remote user for, and receives, selected file. *)
  352. (*                                                                      *)
  353. (*     Calling sequence:                                                *)
  354. (*                                                                      *)
  355. (*        Upload_A_File;                                                *)
  356. (*                                                                      *)
  357. (*----------------------------------------------------------------------*)
  358.  
  359. VAR
  360.    File_Name         : AnyStr;
  361.    Trans_Mode        : AnyStr;
  362.    Transfer_Protocol : Transfer_Type;
  363.    OK_To_Upload      : BOOLEAN;
  364.    Save_Attended     : BOOLEAN;
  365.  
  366. BEGIN (* Upload_A_File *)
  367.                                    (* Get transfer protocol *)
  368.  
  369.    Transfer_Protocol := Get_Xfer_Protocol;
  370.  
  371.    IF Transfer_Protocol = None THEN EXIT;
  372.  
  373.                                    (* Get file name to transfer *)
  374.    Host_Send_String( CR_LF_Host );
  375.    Host_Prompt_And_Read_String('Enter file name to upload: ',
  376.                                 File_Name, TRUE );
  377.  
  378.    IF ( File_Name = '' ) THEN EXIT;
  379.  
  380.    IF ( POS( ^X , File_Name ) > 0 ) THEN EXIT;
  381.  
  382.    IF ( Privilege = 'S' ) THEN
  383.       OK_To_Upload := TRUE
  384.    ELSE
  385.       BEGIN
  386.          IF ( ( POS( '*', File_Name ) = 0 ) AND
  387.             ( ( POS( '?', File_Name ) = 0 ) ) ) THEN
  388.             OK_To_Upload := NOT Check_If_File_Exists( File_Name, Host_Mode_Upload )
  389.          ELSE IF ( Single_File_Protocol[Transfer_Protocol] ) THEN
  390.             BEGIN
  391.                OK_To_Upload := FALSE;
  392.                Host_Send_String( CR_LF_Host );
  393.                Host_Send_String('Wildcards are not allowed for this protocol.');
  394.             END
  395.          ELSE
  396.             OK_To_Upload := TRUE;
  397.       END;
  398.  
  399.    IF Ok_To_Upload THEN
  400.       BEGIN                        (* FileName is global for transfers *)
  401.  
  402.          FileName := File_Name;
  403.  
  404.          Host_Send_String( CR_LF_Host );
  405.          Host_Send_String_With_CR('Ready to receive, begin your send procedure.');
  406.  
  407.          Async_Drain_Output_Buffer( Five_Seconds );
  408.  
  409.          Save_Attended := Attended_Mode;
  410.  
  411.          Attended_Mode := FALSE;
  412.  
  413.          Host_Status('Receiving file');
  414.  
  415.          PibDownLoad( Transfer_Protocol );
  416.  
  417.          Host_Status(Cur_Host_Status);
  418.  
  419.          Attended_Mode := Save_Attended;
  420.  
  421.                                    (* Reset window *)
  422.  
  423.          Window( 1, 1, Max_Screen_Col, Max_Screen_Line - 2 );
  424.  
  425.       END
  426.    ELSE
  427.       BEGIN
  428.          Host_Send_String( CR_LF_Host );
  429.          Host_Send_String_With_CR('File already exists, upload cancelled.');
  430.          OK_To_Upload := FALSE;
  431.       END;
  432.  
  433. END   (* Upload_A_File *);
  434.  
  435. (*----------------------------------------------------------------------*)
  436. (*             Get_Transfer_Time --- Get transfer time for files        *)
  437. (*----------------------------------------------------------------------*)
  438.  
  439. PROCEDURE Get_Transfer_Time( VAR File_Spec             : AnyStr;
  440.                              VAR N_Files               : INTEGER;
  441.                              VAR Transfer_Time_Message : AnyStr );
  442.  
  443. (*----------------------------------------------------------------------*)
  444. (*                                                                      *)
  445. (*     Procedure:  Get_Transfer_Time                                    *)
  446. (*                                                                      *)
  447. (*     Purpose:    Gets transfer time for download                      *)
  448. (*                                                                      *)
  449. (*     Calling sequence:                                                *)
  450. (*                                                                      *)
  451. (*        Get_Transfer_Time(     File_Spec             : AnyStr;        *)
  452. (*                           VAR N_Files               : INTEGER;       *)
  453. (*                           VAR Transfer_Time_Message : AnyStr );      *)
  454. (*                                                                      *)
  455. (*           File_Spec             --- File spec for files to get       *)
  456. (*           N_Files               --- # of files to be transferred     *)
  457. (*           Transfer_Time_Message --- Message about transfer time      *)
  458. (*                                                                      *)
  459. (*----------------------------------------------------------------------*)
  460.  
  461. VAR
  462.    Total_File_Size: REAL;
  463.    File_Size      : REAL;
  464.    File_Entry     : Directory_Record;
  465.    Last_Found     : BOOLEAN;
  466.    SN_Files       : STRING[8];
  467.    S_File_Size    : STRING[8];
  468.    Fs1            : REAL;
  469.    Fs2            : REAL;
  470.    D_File_Name    : STRING[13];
  471.    I              : INTEGER;
  472.    OK_File        : BOOLEAN;
  473.    Info_Line      : AnyStr;
  474.  
  475. BEGIN (* Get_Transfer_Time *)
  476.  
  477.    Host_Send_String( CR_LF_Host );
  478.  
  479.    Host_Send_String_With_CR('Scanning file list ... ');
  480.  
  481.                                    (* No files = 0 total file size at start *)
  482.    Total_File_Size := 0.0;
  483.    N_Files         := 0;
  484.                                    (* Append download directory name *)
  485.                                    (* if necessary.                  *)
  486.  
  487.    IF ( POS( '\' , File_Spec ) = 0 ) AND
  488.       ( POS( ':' , File_Spec ) = 0 ) THEN
  489.       File_Spec :=  Host_Mode_Download + File_Spec;
  490.  
  491.                                    (* See if any files at all *)
  492.  
  493.    Last_Found := ( Dir_Find_First_File( File_Spec, File_Entry ) <> 0 );
  494.  
  495.    WHILE ( NOT Last_Found ) DO
  496.       BEGIN (* WHILE *)
  497.                                    (* Pick up file name, check if it *)
  498.                                    (* is on Xferlist.                *)
  499.          D_File_Name      := '';
  500.          OK_File          := FALSE;
  501.  
  502.          I                := 1;
  503.  
  504.          WHILE( File_Entry.File_Name[I] <> CHR( 0 ) ) AND ( I <= 12 ) DO
  505.             BEGIN
  506.                D_File_Name := D_File_Name + File_Entry.File_Name[I];
  507.                I           := I + 1;
  508.             END;
  509.  
  510.          IF ( Privilege = 'S' ) THEN
  511.             OK_File := TRUE
  512.          ELSE
  513.             OK_File := ( Scan_Xfer_List( D_File_Name ) > 0 );
  514.  
  515.                                    (* If OK to download, add its length *)
  516.                                    (* into current running total.       *)
  517.          IF OK_File THEN
  518.             BEGIN (* OK_File *)
  519.                                    (* Increment file count *)
  520.  
  521.                N_Files := N_Files + 1;
  522.  
  523.                                    (* Display message if first file *)
  524.  
  525.                IF ( N_Files = 1 ) THEN
  526.                   BEGIN
  527.                      Host_Send_String_With_CR(' File name      Size     Trans. time');
  528.                      Host_Send_String_With_CR('============  ========   ===========');
  529.                   END;
  530.                                    (* Pick up file size    *)
  531.  
  532.                Fs1     := File_Entry.File_Size[1];
  533.                Fs2     := File_Entry.File_Size[2];
  534.  
  535.                IF Fs1 < 0 THEN Fs1 := Fs1 + 65536.0;
  536.                IF Fs2 < 0 THEN Fs2 := Fs2 + 65536.0;
  537.  
  538.                File_Size       := Fs2 * 65536.0 + Fs1;
  539.                Total_File_Size := Total_File_Size + File_Size;
  540.  
  541.                                    (* Display information           *)
  542.  
  543.                STR( File_Size:8:0, S_File_Size );
  544.  
  545.                Info_Line := D_File_Name +
  546.                             DUPL( ' ' , 14 - LENGTH( D_File_Name ) ) +
  547.                             S_File_Size + '     ' +
  548.                             TimeString( ROUND( ( File_Size / 128.0 ) + 0.49 ) *
  549.                                         ( Trans_Time_Val / Baud_Rate ),
  550.                                         Military_Time );
  551.  
  552.                Host_Send_String_With_CR( Info_Line );
  553.  
  554.                                    (* See if more files to transfer *)
  555.  
  556.                Last_Found := Last_Found OR
  557.                              ( Dir_Find_Next_File( File_Entry ) <> 0 );
  558.  
  559.             END   (* OK_File *);
  560.  
  561.       END  (* WHILE *);
  562.                                    (* Pick up transfer time *)
  563.  
  564.       Transfer_Time_Message := 'Approximate transfer time for ';
  565.  
  566.       IF ( N_Files <= 1 ) THEN
  567.          Transfer_Time_Message := Transfer_Time_Message + '1 file is '
  568.       ELSE
  569.          BEGIN
  570.             STR( N_Files , SN_Files );
  571.             Transfer_Time_Message := Transfer_Time_Message + SN_Files
  572.                                      + ' files is ';
  573.          END;
  574.  
  575.       Transfer_Time_Message := Transfer_Time_Message +
  576.                                TimeString( ROUND( ( Total_File_Size / 128.0 ) + 0.49 ) *
  577.                                            ( Trans_Time_Val / Baud_Rate ),
  578.                                            Military_Time );
  579.  
  580. END   (* Get_Transfer_Time *);
  581.  
  582. (*----------------------------------------------------------------------*)
  583. (*             Download_A_File  --- Send file to remote user            *)
  584. (*----------------------------------------------------------------------*)
  585.  
  586. PROCEDURE Download_A_File;
  587.  
  588. (*----------------------------------------------------------------------*)
  589. (*                                                                      *)
  590. (*     Procedure:  Download_A_File;                                     *)
  591. (*                                                                      *)
  592. (*     Purpose:   Prompts remote user for, and sends, selected file.    *)
  593. (*                                                                      *)
  594. (*     Calling sequence:                                                *)
  595. (*                                                                      *)
  596. (*        Download_A_File;                                              *)
  597. (*                                                                      *)
  598. (*----------------------------------------------------------------------*)
  599.  
  600. VAR
  601.    File_Name         : AnyStr;
  602.    Trans_Mode        : AnyStr;
  603.    Transfer_Protocol : Transfer_Type;
  604.    N_Files           : INTEGER;
  605.    Save_Attended     : BOOLEAN;
  606.  
  607. BEGIN (* Download_A_File *)
  608.                                    (* Get transfer protocol *)
  609.  
  610.    Transfer_Protocol := Get_Xfer_Protocol;
  611.    IF Transfer_Protocol = NONE THEN EXIT;
  612.  
  613.                                    (* Get file spec for files to get *)
  614.  
  615.    Host_Send_String( CR_LF_Host );
  616.    Host_Prompt_And_Read_String('Enter file name to download: ',
  617.                                 File_Name, TRUE );
  618.  
  619.    IF ( File_Name = '' ) THEN EXIT;
  620.  
  621.    IF ( POS( ^X , File_Name ) > 0 ) THEN EXIT;
  622.  
  623.                                    (* Check that file name is proper form *)
  624.    IF ( Privilege <> 'S' ) THEN
  625.       IF ( POS( '\' , File_Name ) <> 0 ) OR
  626.          ( POS( ':' , File_Name ) <> 0 ) THEN
  627.          BEGIN
  628.             Host_Send_String( CR_LF_Host );
  629.             Host_Send_String('That is not a valid file specification.');
  630.             EXIT;
  631.          END;
  632.                                    (* Check wildcards on wrong protocols *)
  633.  
  634.    IF ( ( POS( '*', File_Name ) <> 0 ) OR
  635.         ( POS( '?', File_Name ) <> 0 ) ) THEN
  636.       IF ( Single_File_Protocol[Transfer_Protocol] ) THEN
  637.          BEGIN
  638.             Host_Send_String( CR_LF_Host );
  639.             Host_Send_String('Wildcards are not allowed for this protocol.');
  640.             EXIT;
  641.          END;
  642.                                    (* Get file names and sizes *)
  643.  
  644.    Get_Transfer_Time( File_Name , N_Files , Trans_Mode );
  645.  
  646.    IF ( N_Files <= 0 ) THEN
  647.       BEGIN
  648.          Host_Send_String( CR_LF_Host );
  649.          Host_Send_String_With_CR('No files found to send, transfer cancelled.');
  650.          EXIT;
  651.       END;
  652.                                    (* FileName is global for transfers *)
  653.    FileName := File_Name;
  654.  
  655.    Host_Send_String( CR_LF_Host );
  656.    Host_Send_String_With_CR( Trans_Mode );
  657.    Host_Send_String_With_CR('Ready to send, begin your receive procedure.');
  658.  
  659.                                    (* Get the file(s) ! *)
  660.  
  661.    Async_Drain_Output_Buffer( Five_Seconds );
  662.  
  663.    Save_Attended := Attended_Mode;
  664.  
  665.    Attended_Mode := FALSE;
  666.  
  667.    Host_Status('Sending file');
  668.  
  669.    PibUpLoad( Transfer_Protocol );
  670.  
  671.    Host_Status(Cur_Host_Status);
  672.  
  673.    Attended_Mode := Save_Attended;
  674.  
  675.                                    (* Reset window *)
  676.  
  677.    Window( 1, 1, Max_Screen_Col, Max_Screen_Line - 2 );
  678.  
  679. END   (* Download_A_File *);
  680.  
  681. (*----------------------------------------------------------------------*)
  682.  
  683. BEGIN (* Process_File_Transfer_Commands *)
  684.  
  685.                                    (* Indicate we're in file transfer *)
  686.  
  687.    Cur_Host_Status := 'File section';
  688.  
  689.    Host_Status(Cur_Host_Status);
  690.                                    (* Stay in files section for a while *)
  691.    Back := FALSE;
  692.                                    (* Prompt for commands *)
  693.    Display_Xfer_Commands;
  694.                                    (* Wait for command to be entered *)
  695. ReadChar:
  696.                                    (* No keyboard input yet *)
  697.    Kbd_Input := FALSE;
  698.  
  699.    REPEAT
  700.       Found_Ch := Async_Receive( Ch ) OR KeyPressed;
  701.       Done     := Done OR ( NOT Host_Carrier_Detect );
  702.       IF ( NOT Found_Ch ) THEN
  703.          GiveAwayTime( 2 );
  704.    UNTIL Done OR Found_Ch;
  705.                                    (* Process input from keyboard *)
  706.    Dont_Echo := FALSE;
  707.  
  708.    IF KeyPressed THEN
  709.       BEGIN
  710.          READ( KBD , Ch );
  711.          Kbd_Input := TRUE;
  712.          IF ( ORD( Ch ) = ESC ) AND KeyPressed THEN
  713.             BEGIN
  714.                Dont_Echo := TRUE;
  715.                READ( Kbd, Ch );
  716.                CASE ORD( Ch ) OF
  717.                   F1 : Ch := 'G';
  718.                   F2 : Ch := 'Q';
  719.                   F3 : BEGIN
  720.                           DosJump('');
  721.                           Ch := ' ';
  722.                        END;
  723.                   F5 : BEGIN
  724.                           WRITELN;
  725.                           WRITELN('Current caller is ',Cur_User_Name);
  726.                           Ch := ' ';
  727.                        END;
  728.                END (* CASE *);
  729.             END;
  730.       END;
  731.  
  732.    IF ( Ch = ' ' ) THEN GOTO ReadChar;
  733.  
  734.    IF ( Not DONE ) THEN
  735.                                    (* Echo command character *)
  736.       IF( NOT Dont_Echo ) THEN
  737.          BEGIN
  738.             IF Printer_On THEN
  739.                WRITELN( Lst, Ch );
  740.             IF Capture_On THEN
  741.                WRITELN( Capture_File, Ch );
  742.             Host_Send_String( Ch + CR_LF_Host );
  743.          END;
  744.                                    (* Process command request *)
  745.       CASE UpCase( Ch ) OF
  746.  
  747.          'U':  Upload_A_File;
  748.          'D':  Download_A_File;
  749.          'Q':  BEGIN
  750.                   IF Kbd_Input THEN
  751.                      BEGIN
  752.                         Host_Send_String_With_CR('System operator shutting ' +
  753.                                                   'down system.');
  754.                         Host_Send_String_With_CR('Thanks for calling.');
  755.                         Done := TRUE;
  756.                      END
  757.                   ELSE
  758.                      BEGIN
  759.                         Host_Send_String_With_CR('Quit and logoff');
  760.                         Done := TRUE;
  761.                      END;
  762.                END;
  763.          'L':  List_Files_For_Transfer;
  764.          'X':  Expert_On := NOT Expert_On;
  765.          'M':  BEGIN
  766.                   Back         := TRUE;
  767.                   Host_Section := 'M';
  768.                END;
  769.          'G':  IF Kbd_Input THEN
  770.                   BEGIN
  771.                      Host_Send_String_With_CR(' ... System operator wishes' +
  772.                                                ' to chat, please wait ...');
  773.                      Host_Send_String_With_CR(' ');
  774.                      Back           := TRUE;
  775.                      Last_Host_Sect := 'F';
  776.                      Host_Section   := 'G';
  777.                   END;
  778.  
  779.          'J':  IF ( Privilege = 'S' ) THEN
  780.                   BEGIN
  781.                      Host_Section   := 'D';
  782.                      Last_Host_Sect := 'F';
  783.                      Back           := TRUE;
  784.                   END
  785.                ELSE
  786.                   Host_Send_String( ^G );
  787.  
  788.          'Z':  IF Kbd_Input THEN
  789.                   DosJump('');
  790.  
  791.          ELSE  Host_Send_String( ^G );
  792.  
  793.       END (* CASE *)
  794.  
  795. END   (* Process_File_Transfer_Commands *);
  796.  
  797.